#!/usr/bin/perl
# CCNCore::IPC::SpoolRemote.pm
# Copyright (C) 2006  Stephane Alnet
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
# 

#
# For more information: http://carrierclass.net/
#

# A Jabber client that processes remote spool commands.

use strict; use warnings;

package CCN::IPC::SpoolRemote;
use base qw(CCN::Class);

use CCN::Daemon;
use CCN::IPC::SingleInstance;

# sub here()
# sub cmd()
# sub message_store()
# sub jabber_config()
# sub debug_file()

sub initialize
{
    my $self = shift;
    
    $self->{daemon} = new CCN::Daemon 'SpoolRemote';
    $self->{single} = new CCN::IPC::SingleInstance($self->here(),$self->cmd());
}

# This script is called from crontab every 1 minutes.
# Only one instance should be running at any time.
sub run()
{
    our $self = shift;

    # It's still running if it was last seen no less than one minute ago.
    $self->{daemon}->log_for('info','SpoolRemote already running.'), exit 0
        if( defined $self->{single}->last_touched and $self->{single}->last_touched > time() - 90 );

    $self->{daemon}->log_for('info','Killing late UnspoolRemote.'), $self->{single}->killit(),
        if defined $self->{single}->last_touched and $self->{single}->last_touched > time() - 180;

    # /Preparatory code


    # Dedicated processing

    our $Connection;

    # RPC Callback
    sub spool
    {
        my $iq = shift;
        my $params = shift;
        $self->{daemon}->log_for ('info', "jabber spool: $params->[3]");

        my @params = @{$params};
        my $their_msg_pk = shift @params;
        my $msg_pk = $self->message_store->insert(@params);

        return ('ok',['ccn-received',$msg_pk]);
    }

    # Jabber processing
    my $resource = 'RPCServer';

    # Bug in Net::Jabber::Client :
    # Net::Jabber::Protocol::callbackInit() never gets called by default
    # We force it manually here.
    # (This was reported as Debian bug # 408173.)
    sub callbackInit
    {
        my $self = shift;

        $self->SetIQCallBacks("jabber:iq:last"=>
                              {
                                get=>sub{ $self->callbackGetIQLast(@_) },
                                result=>sub{ $self->callbackResultIQLast(@_) }
                              },
                              "jabber:iq:rpc"=>
                              {
                                set=>sub{ $self->callbackSetIQRPC(@_) },
                              },
                              "jabber:iq:time"=>
                              {
                                get=>sub{ $self->callbackGetIQTime(@_) },
                                result=>sub{ $self->callbackResultIQTime(@_) }
                              },
                              "jabber:iq:version"=>
                              {
                                get=>sub{ $self->callbackGetIQVersion(@_) },
                                result=>sub{ $self->callbackResultIQVersion(@_) }
                              },
                             );
    }
    # /Bug

    sub Stop
    {
        $Connection->Disconnect();
        $self->info('Disconnected.');
        return 0;
    }

    sub OnAuth()
    {
        $Connection->RosterGet();
        $Connection->PresenceSend();
        $self->info('Ready.');
    }

    our $processed_once = 0;

    sub OnProcess()
    {
        $processed_once = 1;

        if( not defined $self->{single}->last_touched or $self->{single}->last_touched <= time() - 10 )
        {
            $self->{single}->touch() or $self->error("Could not update touch file: $!");
        }
        # No further processing
    }

    sub OnDisconnect()
    {
        # $self->info('Disconnect.');
    }

    sub OnExit()
    {
        # $self->info('Exit.');
    }

    sub restart()
    {
        $self->info('Request to restart SpoolRemote.');
        unlink $self->here();
        exec cmd();
    }

    sub stop()
    {
        Stop();
        unlink $self->here();
        exit 0;
    }


    # $SIG{HUP}  = \&restart;

    # On Linux, have to use the method described in perlipc:
    use POSIX;
    my $sigset = POSIX::SigSet->new();
    my $action = POSIX::SigAction->new(\&restart,
                                       $sigset,
                                       &POSIX::SA_NODEFER);
    POSIX::sigaction(&POSIX::SIGHUP, $action);

    $SIG{TERM} = \&stop;
    $SIG{INT}  = \&Stop;

    # If we do not go through OnProcess (for example because the XMPP server is down),
    # and we do not touch() here, we will keep spawning processes until we run out of
    # descriptors/memory.
    # Yes, it may lead to situations where we do not start when we should.
    $self->{single}->touch();
    $self->info('Started.');

    while(1)
    {
        use Net::Jabber qw(Client);
        
        $Connection = new Net::Jabber::Client(
            'debugfile'         => $self->debug_file,
            'debuglevel'        => 1,
        );

        if($Connection)
        {
            $Connection->Info( name => 'CCN RPCServer', version => '1.0' );

            callbackInit($Connection);

            $Connection->RPCSetCallBacks(
                'spool'         =>  \&spool,
            );

            $Connection->SetCallBacks(
                'onauth'        => \&OnAuth,
                'onprocess'     => \&OnProcess,
                'ondisconnect'  => \&OnDisconnect,
                'onexit'        => \&OnExit,
            );

            $processed_once = 0;
            
            my $jabber_config = $self->jabber_config();

            $Connection->Execute(
                'myhostname'        =>  $self->jabber_config->{domain},
                'hostname'          =>  $self->jabber_config->{server},
                'port'              =>  $self->jabber_config->{port},
                'username'          =>  $self->jabber_config->{username},
                'password'          =>  $self->jabber_config->{password},
                'resource'          =>  $resource,
                'register'          =>  0, # Attempt to register if account doesn't exist
                'processtimeout'    =>  20, # Touch the file every 20s at most
                'connectattempts'   =>  2, # -1 = Forever
            );

        }

        undef $Connection;

        # if the connection simply failed (e.g. wrong password), do not retry.
        $self->error('SpoolRemote connection failed'),
        unlink($self->here()),
        exit 2 if not $processed_once;

        # Wait a little bit before connectin again.
        sleep(1);
    }
}

1;